perm filename S2.F4[LK,LCS]2 blob
sn#140142 filedate 1975-01-16 generic text, type T, neo UTF8
00100 SUBROUTINE READIT
00200 COMMON /Q/ BNW(100),NWZ /INS/INST(27),BG(60) /TYP/SOS,JOUT,
00300 1 LN,ITYP,TPALN(4),JED
00400 CC 7/74 COLGATE COMMON/TYP/ IS FOR COLTTY ROUT.
00500 COMMON/A/ V(2000),ROFF(27),NP(27),PCH(27,32),
00600 1 RDEV(27),IPT(27,31),XT(27),OTH(20,16),SCAL(101)
00700 1 ,P1(27),JFM(4),COPY(30),IFM(80)
00800 1 ,FINM(6),TINST(5),ENFI(5),TEDIT(4),INVIS(27)
00900 DIMENSION IV(2000),LIST(78),JNP(80)
01000 C WITH VX,IOUT AT 70 AND IFM AT 80 OK FOR ONLY
01100 C 40 LIT CHARS + 30 PARAMS PER INST.
01200 C 60 BG TIMES AVAILABLE. FOR INSTS AND INSERTS AND EDITS.
01300 COMMON P(30),J,L,CNT(27),BT,PL(48),MK,DF,DUR(27)
01400 1 ,IQ(27),KL,X,ZPAR,KA,LK,NNUM,JJ,JA,ISUB,NFLG,IXX,ISEMI,IQT
01500 1 ,INP(144),VX(70),ISCA(12),IDAT(11),IAMP,K,KN,M,ML,CODE,IBLA
01600 COMMON/B/MOT,PR,T5,NINS,I,TP,RA,KZY,NWX,INONLY,MX,
01700 1 Y,Z,ISLAC,MZ,N,IDALL,JC,JG,RB,IJ,IX,BW,KB,NL,RC,W,
01800 1 ZZ,CHN,YY
01900 1 /D/TF,AMPFAC,OP1,DURX,IXIN,IFLNM
02000 1 /C/LPAR,IPRN,QX,RETRO,INVRT,ICON,LCNT,
02100 1 PARENS,JZ,BY,MLX,IZ,ALL,JD,LEND,QTS,ITMP,
02200 1 LP,ILIT,NLIT,KTMP,IC,RAX,RD,IA
03720 C /C/=26
03800 EQUIVALENCE (VX1,VX(1)),(JNP,INP1,INP(1)),(IPP,ISCA(2))
03900 1 ,(ISS,ISCA(9)),(ITT,ISCA(11))
04000 1 ,(IE,ISCA(5)),(ID,ISCA(3)),(IF,ISCA(6)),(IAA,ISCA(10))
04100 1 ,(VX2,VX(2)),(VX3,VX(3)),(VX4,VX(4)),(IDOT,IDAT(11))
04200 1 ,(V,IV),(LIST,IFM(3)),(IG,ISCA(8))
19500 C *************** READS INPUT ***********************
19600 2308 IF(ITYP)GO TO 2127
19700 DATA TINST /25H(' TYPE INST NAME, ETC'/)/,KSLA/'/'/
19800 1,TEDIT/20H(' RETYPE LINE?'/ )/,IEN/'N'/
19900 23081 TYPE TINST
20000 ACCEPT 77732,JNP
20050 77732 FORMAT(80A1)
20100 CC IF(JED)WRITE(21,77732)INP
20200 IF(JED)CALL COLTTY(JNP,21)
20300 JFM(4)='80A1)'
20400 C PUTS ON LPT AND TTY
20500 GO TO 1074
20600 CC 6/74 COLGATE2127 JREAD=1
20700 CC 6/74 COLGATE 4400 READ(1,77732,END=2337)JNP
20800 2127 IF(READER(JNP))CALL RUNIT
20900 C READS A LINE. IF END OF FILE, JUMPS.
21000 CC SEE END OF PG.6 IF(SOS)WRITE(JOUT,87732)INP
21100 CC 7/74 IF(SOS)CALL COLTTY(JNP,JOUT,3)
21200 CC 6/74 COLGATE GO TO(441,442,443,444,445,446)JREAD
21300
21400 441 JFM(4)='80A1)'
21500 IF(LN.EQ.0)GO TO 1074
21600 CC REREAD 2114,LN,JNP
21650 C**** READS ONLY FILES WITH LINE NUMBERS!
21700 JFM(1)=' (I,A'
21800 CALL FMT(JFM,JNP,MLX)
21900 REREAD JFM,LN,J,JNP
22000 GO TO 4127
22100 1074 JFM(1)=' (A'
22200 CALL FMT(JFM,JNP,MLX)
22300 REREAD JFM,J,JNP
22400 4127 IF(JED.OR.K.EQ.'Y')GO TO 41271
22500 C K CHECK IS TO PASS AFTER RETYPING
22600 TYPE TEDIT
22700 ACCEPT 77732,K
22800 IF(K.EQ.'Y')GO TO 23081
22900 IF(K.EQ.IG)JED=-1
23000
23100
23200 41271 IF(J.EQ.IBLA)GO TO 2308
23300 MLX=1
23400 IZ=0
23500 JA=-1
23600 ISUB=4
23650 CALL CLEAN(INP,LEND)
23675 C CLEANS OUT = AND , AND FINDS LINE LENGTH.
23700 ALL=1.
23800 VX1=0
23900 VX2=0
24000 VX3=0
24100 LK=-1
24200 K=0
24300 IF(V(I-1).NE.-9900.-BY)GO TO 364
24400 BY=-1.
24500 I=I-1
24600 364 DO 361 JD=1,LEND
24700 N=INP(JD)
24800 IF(N.NE.'R')GO TO 361
24900 C LOOKS FOR 'RESTART'
25000 DO 3611 M=JD,LEND
25100 KL=INP(M)
25200 IF(KL.EQ.IBLA.OR.KL.EQ.ISEMI)GO TO 3631
25210 CCZZZ IF(KL.EQ.IBLA.OR.KL.EQ.ISEMI.OR.KL.EQ.KSLA.OR.KL.EQ.',')GO TO 3631
25300 3611 INP(M)=IBLA
25400 C CHANGES 'RESTART' TO BLANKS
25500 3631 DO 363 N=1,NINS
25600 IF(J.NE.INST(N))GO TO 363
25700 IQ(N)=-1
25800 C SETS RESTART FLAG. THIS INST WILL NOW APPEAR WITH NEW NUM.
25900 GO TO 362
26000 363 CONTINUE
26100 361 IF(N.EQ.ISEMI)GO TO 6773
26200 6773 K=K+1
26300 IF(K.GT.NINS)GO TO 36
26400 IF(INST(K).NE.J.OR.IQ(K).EQ.-1)GO TO 6773
26500 C FINDS CORRECT INST NUM. PASSES RESTARTED INSTS.
26600 LK=K
26700 GO TO 1773
26800 36 IF(J.EQ.'RUN;'.OR.J.EQ.'RUN')CALL RUNIT
26900 IF(J.EQ.'INSER'.OR.J.EQ.'EDIT')ISUB=6
27000 IF(J.EQ.ITMPO.OR.J.EQ.'CONDU'.OR.J.EQ.'PLAY'.OR.ISUB.GT.4)
27100 1GO TO 1773
27200 IF(J.EQ.'SECTI')GO TO 1081
27300 C****************** ABOVE AND BELOW FOR 'SECTIONS'
27400 IF(J.EQ.'END'.OR.J.EQ.'END S'.OR.J.EQ.'FINIS')GO TO 1082
27500 362 LK=NINS+1
27600 IF(LK.GT.KZY)GO TO 99
27700 INST(LK)=J
27800 IZ=LK
27900 GO TO 1773
28000
28100 C*********** DOWN TO 99 FOR 'SECTIONS'
28200 1083 V(I)=-99.
28300 KL=1
28400 GO TO 3083
28500 C READS 'PLAY SECT. N1,N2'
28600 1081 V(I)=-199.
28700 KL=4
28800 3083 DO 2081 K=KL,72
28850 C****** OR 80 ↑↑↑↑↑↑↑↑↑ ?????
28900 IF(INP(K).EQ.IBLA)GO TO 2081
29000 IV(I+1)=INP(K)
29100 I=I+2
29200 3081 BY=-1.
29300 GO TO 2308
29400 2081 CONTINUE
29500 C READS SECTION IDENTIFIER, -199. MARKS BEGINNING
29600 C1082 IF(V(I-1).EQ.-9900.-BY)I=I-1
29700 C********* FEB 15,71
29800 1082 V(I)=-299.
29900 I=I+1
30000 GO TO 3081
30100 C MARKS END OF SECTION
30200 C************************
30300
30400 99 TYPE 199,LN
30500 STOP
30510 8001 FORMAT(A5,5F)
30555 107 FORMAT(I,A5,5F)
30600 199 FORMAT(' ERROR!! LAST LINE READ =',I6/)
30700 4 IF(LK.LE.NINS)GO TO 8773
30800 IF(ALL.GT.0)GO TO 1004
30900 IF(IDALL.GT.0)GO TO 8773
31000 BG(LK)=VX1
31100 IDALL=LK
31200 GO TO 2004
31300 C 'MOVE' CHANGES IN 'ALINS' CAN'T BE RESET IN INDIV. INSTS.
31400 1004 BG(LK)=VX1
31500 IF(LK.EQ.IZ)VX1=0
31600 C MAY 3,71 **** ALL PARAMS WILL BE SET UP AT TIME 0.
31700 C CHECK EFFECT ON 'MOVE'!
31800 C ******** APR.23, 1971 FIXES BG TIMES IN 'MOVE'?????!!!!!!!
31900 2004 NINS=LK
32000 IF(VX3.NE.0)VX2=10000.+VX3
32100 IF(VX2.EQ.0)VX2=-1
32200 DUR(LK)=VX2
32300 GO TO 900
32400 C******** ABOVE FOR REST ONLY ENTRIES. FEB 18,71
32500 8773 IF(VX2.NE.0)VX1=VX1*10000.+VX2
32600 900 IF(VX1.EQ.BY.AND.J.NE.'PLAY')GO TO 5773
32700 C*********** 'PLAY' IS FOR 'SECTIONS'
32800 BY=VX1
32900 C BY=CURRENT BG TIME.
33000 V(I)=-9900.-BY
33100 I=I+1
33200 IF(NWZ.NE.0)CALL BGSORT(BY)
33300 5773 IF(J.EQ.'TEMPO')GO TO 1106
33400 IF(J.EQ.'CONDU')GO TO 3018
33500 IF(J.EQ.'PLAY')GO TO 1083
33510 C*********** ABOVE FOR 'SECTIONS'
33520
33530
33540 4773 NW=LPAR
33710 CZZZZZZZ MLX=ML
33755 ML=MLX
33800 IF(I.GT.1900)TYPE 107,I
33900 ALL=1.
34000 DF=0
34100 ISUB=1
34150 IF(MLX.LT.LEND)GO TO 17732
34200 GO TO 7773
34225 CZZZZZZZZZZZZZZZZZZZZZZZZ
34250 1299 IF(MLX.LE.LEND)GO TO 1773
34255 CZZZZZZZZZZZZZZZ .LT. ZZZZZZZZZZZZ
34260 CC1299 IF(JZ.NE.0)GO TO 2773
34300
34400
35700 7773 IF(READER(JNP))CALL RUNIT
35800 C READS A LINE. IF END OF FILE, JUMPS.
35900 CC442 IF(LN.NE.0)REREAD 2114,LN,INP
36000 IF(INP1.EQ.IBLA)GO TO 7773
36100 IF(JED)GO TO 77733
36200 TYPE TEDIT
36300 ACCEPT 77732,K
36400 IF(K.NE.'Y')GO TO 442
36450 TYPE TPALN
36475 ACCEPT 77732,JNP
36500 442 IF(K.EQ.IG)JED=-1
36600 C DOESN'T WORK FOR EDITS AND INSERTS YET???
36700
36800
36900 77733 MLX=1
36975 C FOR CONTINUATION LINES.(CAN'T 'CONTINUE' TWICE IN A ROW!!)
37000 C 'LISTS' MUST END WITH ; IN NEW(7/74) VERSION.
37005 CALL CLEAN(INP,LEND)
37010 CC2773 CALL CLEAN(INP,LEND)
37100 1773 IF(IPRN.EQ.0)GO TO 17732
37200 L=I-1
37300 IF(QTS.AND.V(I-1).EQ.999.)L=L-1
37400 IPRN=IPRN-1
37500 IF(PARENS.EQ.0)GO TO 17733
37600 PARENS=0
37700 LIST(LCNT+2)=L
37800 LCNT=LCNT+3
37900 IF(IPRN.EQ.0)GO TO 17732
38000 IPRN=0
38100 17733 LIST(MOT)=L
38200 MOT=0
38300 C FOR ERROR TRAP
38400
38500 CC17732 JZ=0
38600 17732 N=0
38700 17731 ML=MLX
38800
38900 C BIG LOOP -- TO END OF PAGE 1.
39000 JD=ML
39100 975 N=INP(JD)
39200 IF(N.EQ.IBLA)GO TO 236
39210 CCZZZ IF(N.EQ.IBLA.OR.N.EQ.',')GO TO 236
39300 C ((((())))) MAY 13,71 /Z (D4/E/X 2 3)/ CS/ ETC. CAN USE 26 LABELS.
39400 33611 IF(N.NE.'('.AND.N.NE.')')GO TO 2361
39500 INP(JD)=IBLA
39600 L=JD-1
39700 5113 IF(INP(L).NE.IBLA)GO TO 2113
39800 L=L-1
39900 GO TO 5113
40000 2113 IF(N.EQ.')')GO TO 3361
40100 IF(PARENS.EQ.0)GO TO 1140
40200 LCNT=LCNT+3
40300 IF(MOT.NE.0)GO TO 11403
40400 MOT=LCNT-1
40500 1140 DO 11401 JC=1,LCNT-1,3
40600 IF(INP(L).NE.LIST(JC))GO TO 11401
40700 C FINDS DUPLICATE IDENTIFIER
40800 TYPE 11402,INP(L)
40900 GO TO 99
41000 11403 TYPE 11404
41100 GO TO 99
41200 11404 FORMAT(' MORE THAN 2 PARENS OPEN'/)
41300
41400 11402 FORMAT(' MOTIVIC (',A1,') USED TWICE')
41500 11401 CONTINUE
41600 LIST(LCNT)=INP(L)
41700 PARENS=-1.
41800 INP(L)=IBLA
41900 LIST(LCNT+1)=I
42000 GO TO 236
42100 C ''''''' FOR SINGLE QUOTES
42200 3361 IPRN=IPRN+1
42300 GO TO 236
42400 C JUMPS BACK INTO QUOTE SECTION
42500 CQ IF(PARENS.EQ.0)GO TO 2140
42600 CQ LIST(LCNT+2)=L
42700 CQ LCNT=LCNT+3
42800 CQ PARENS=0
42900 CQ GO TO 33612
43000 CQ2140 LIST(MOT)=L
43100 CQ GO TO 33612
43200 CQC ))))))))))) LAST ) CAN'T APPEAR AT END OF LINE!!
43300 C @@@@@@@@@@@@ /@Z/DS3/ ETC.
43400 2361 IF(N.NE.'@')GO TO 5361
43500 DO 113 L=1,LEND
43600 K=JD+L
43700 C K IS USED AT 240!!!
43800 JG=INP(K)
43900 IF(JG.NE.'-')GO TO 6113
44000 RETRO=0
44100 INP(K)=IBLA
44200 GO TO 113
44300 6113 IF(JG.NE.'$')GO TO 7113
44400 C '$' IS FOR INVERSIONS IN 'NOTES'
44500 INVRT=0
44600 GO TO 113
44700 7113 IF(JG.NE.IBLA)GO TO 4113
44800 113 CONTINUE
44900 4113 DO 6361 L=1,LCNT,3
45000 IF(JG.NE.LIST(L))GO TO 6361
45100 VX1=0
45200 DO 40 M=JD+2,LEND
45300 JG=INP(M)
45400 IF(JG.EQ.IBLA)GO TO 40
45500 CCZZZ IF(JG.EQ.KSLA.OR.JG.EQ.ISEMI.OR.JG.EQ.'*')GO TO 140
45510 IF(JG.EQ.KSLA.OR.JG.EQ.ISEMI)GO TO 140
45600 ML=M
45700 GO TO 240
45800 40 CONTINUE
45900 240 JC=JA
46000 JA=-1
46100 INP(K)=IBLA
46200 CALL SCANR
46300 JA=JC
46400 140 JC=1
46500 KN=LIST(L+1)
46600 M=LIST(L+2)+1
46700 IF(RETRO)GO TO 640
46800 JC=M-1
46900 M=KN-1
47000 KN=JC
47100 JC=-1
47200 RETRO=-1.
47300 640 IF(INVRT)GO TO 940
47400 840 X=V(KN)
47500 V(I)=X+VX1
47600 C FINDS CENTER FOR INVERSION (+TRANSP.)
47700 I=I+1
47800 KN=KN+JC
47900 IF(V(KN-JC).NE.85.)GO TO 940
48000 V(I-1)=85.
48100 GO TO 840
48200
48300 940 Z=V(KN)
48400 IF(INVRT.EQ.0)GO TO 440
48500 IF(VX1.EQ.0)GO TO 540
48600 C " @Q N " WHERE N= 1/2 STEPS IN 'NOTES' OR MULT FACTOR IN OTHERS.
48700 IF(CODE.EQ.-33.)GO TO 440
48800 V(I)=Z*VX1
48900 GO TO 7361
49000 440 IF(Z.EQ.85.)GO TO 540
49100 Y=0
49200 IF(INVRT.EQ.0)Y=(X-Z)*2.
49300 V(I)=Z+VX1+Y
49400 GO TO 7361
49500 540 V(I)=Z
49600 7361 I=I+1
49700 KN=KN+JC
49800 IF(KN.NE.M)GO TO 940
49900
50000 INVRT=-1
50100 RB=V(I-1)
50200 DO 8361 L=JD,LEND
50300 JG=INP(L)
50400 C PUT IN NOV 25, 72
50500 CCZZZ IF(JG.EQ.ISEMI)GO TO 93612
50550 KN=L
50600 INP(L)=IBLA
50700 IF(JG.EQ.KSLA)GO TO 9361
50800 IF(JG.EQ.')')IPRN=IPRN+1
50900 CCZZZ8361 IF(JG.EQ.'*')IAMP=-1
50950 8361 IF(JG.EQ.ISEMI)IAMP=-1
50975 GO TO 93612
51000 9361 MLX=L
51100 C FIX THIS & =IBLA BY CHNGING DO LOOP TO 'GO TO' AT 6721,2722
51200 IF(IAMP.EQ.0.AND.QTS)GO TO 1773
51210 C GO BACK IF NOT END OF LINE
51300 JZ=-1
51400 93612 IF(IAMP.EQ.0)GO TO 93611
51500 C NOV 25, 72
51600 IF(QTS)GO TO 3013
51700 GO TO 2722
51800 C THESE ARE FOR "LIT" ITEMS
51900 C ******* DO NOT USE '@-' OR '@$' WITH 'LIT', RLIST OR RNOT****
52000 C NO $ WITH FUNC. $ WITH NUMS AND RHY CAN GIVE NEG RESULT -- TRY IT!
52100 CCZZZ93611 IF(JG.EQ.ISEMI)GO TO 7773
52150 93611 IF(KN.EQ.LEND)GO TO 7773
52200 JZ=0
52300 IF(IPRN.NE.0)GO TO 1773
52400 C ↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑PICKS UP ' @X)/ ' SITUATION. 22/6/73
52500 GO TO 236
52600 C LAST TIME FOR QUOTES
52700
52800 C********↑↑ ↑↑ WAS TO 6017 JUNE 10,71
52900 C JUMPS TO END STRING OF QUOTES
53000 6361 CONTINUE
53100 GO TO 99
53200 C @@@@@@@@@@@@@@@@@@@@@@@@@@
53300 5361 IF(N.EQ.'$')GO TO 99
53400 C FOUND $ BUT NO @!
53500 IF(N.NE.ID.OR.ISUB.NE.1)GO TO 53611
53600 IF(INP(JD+1).NE.IF)GO TO 236
53700 C JUMP IF NOT DUTY FACTOR
53800 DF=DF-100.
53900 GO TO 43615
54000 53611 IF(N.NE.ISS.OR.INP(JD+1).NE.'U')GO TO 53612
54100 DF=DF-200
54200 C FOR SUBROUTINE FLAG. CAN'T CALL SUBR AT SAME TIME AS REP OR X!!!!
54300 GO TO 43615
54400 53612 IF(N.NE.IAA)GO TO 43611
54500 C FINDS 'ALL'.
54600 IF(INP(JD+1).NE.'L')GO TO 236
54700 ALL=-1.
54800 GO TO 43615
54900 C TYPE 'ALL' AFTER PARAM NUM TO PUT DATA IN ALL INSTS.
55000
55100 C QUAD CALL MUST BE IN 1ST OF 5 PARAMS. QUAD MUST BE FOLLOWED
55200 C BY SPC, / OR ;. OTHER CALLS SUCH AS MOVE,NUM ETC. CAN
55300 C APPEAR BEFORE / OR ;, BUT "ALL" MUST! APPEAR
55400 C BEFORE! QUAD (IF USED).
55500 C ADD AN "F" TO QUAD FOR FUNCTIONS, AN "X" FOR X,Y COORDS.
55600 C BASIC QUAD PRODUCES CIRCLES. /DEGS/RADIUS/CENT. X/CENT. Y/
55700 C QUADX -- /X /Y / (5TH PARAM WILL ALWAYS BE WASTED)
55800 43611 IF(N.NE.'Q'.OR.INP(JD+1).NE.'U')GO TO 4361
55900 QX=-13.
56000 DO 43612 N=JD,LEND
56100 J=INP(N)
56200 IF(J.EQ.IXX)QX=QX-1.
56300 IF(J.EQ.IF)QX=QX-2.
56400 IF(J.EQ.IBLA.OR.J.EQ.KSLA)GO TO 236
56410 CCZZZ IF(J.EQ.IBLA.OR.J.EQ.KSLA.OR.J.EQ.ISEMI.OR.J.EQ.',')GO TO 236
56500 43612 INP(N)=IBLA
56600 4361 IF(N.NE.'I')GO TO 43613
56700 IF(ISUB.NE.4)GO TO 43613
56800 C 'NM INV' MAKES INST NAME, P1 AND P2 INVISIBLE (REPLACES SEG, ETC.)
56900 INVIS(LK)=-1
57000 43615 DO 43614 L=JD,LEND
57100 N=INP(L)
57110 CC IF(N.EQ.IBLA.OR.N.EQ.KSLA)GO TO 236
57200 IF(N.EQ.IBLA.OR.N.EQ.ISEMI)GO TO 236
57210 CCZZZ IF(N.EQ.IBLA.OR.N.EQ.','.OR.N.EQ.ISEMI.OR.N.EQ.KSLA)GO TO 236
57300 43614 INP(L)=IBLA
57400 CC43613 IF(N.NE.KSLA)GO TO 636
57401 43613 IF(N.NE.KSLA)GO TO 1336
57600 CC JZ=-1
57650 IF(JD.GE.LEND-1)JZ=0
57675 C SO IT WILL READ NEXT LINE.
57700 CZZZZZZZZZZZZZZZ INP(JD)=ISEMI
57710 GO TO 336
57800 CCZZZ436 IF(INP(MLX).NE.IBLA)GO TO 336
57900 CCZZZ MLX=MLX+1
58000 CCZZZ GO TO 436
58100 CC636 IF(JD.LT.LEND)GO TO 1336
58102 CC ICON=0
58105 CC GO TO 77731
58106 CC GO TO 7773
58107 C TO CONTINUE ON NEXT LINE.
58110 CCZZZ636 IF(N.NE.ISEMI)GO TO 936
58120 1336 IF(N.NE.ISEMI)GO TO 936
58135 IAMP=-1
58140 CC IF(ISUB.NE.1)IAMP=-1
58160 336 MLX=JD+1
58200 IF(ISUB.EQ.104)GO TO 104
58300 IF(ISUB.GT.3)GO TO 1899
58400 GO TO (101,102,103),ISUB
58500 C PAR MOV LIST OTHERS
58600 CCZZZ936 IF(N.NE.IDOT)GO TO 736
58610 936 IF(N.NE.IDOT)GO TO 136
58700 L=INP(JD+1)
58800 DO 836 KL=1,10
58900 836 IF(L.EQ.IDAT(KL))GO TO 236
59000 IF(CODE.EQ.-22.)INP(JD)=1
59100 GO TO 236
59200 C CHANGES DOTTED RHYTHMS TO '1'S.
59310 CCZZZ736 IF(N.NE.'*')GO TO 136
59400 CCZZZ IAMP=-1
59510 CCZZZ INP(JD)=IBLA
59600 CCZZZ GO TO 336
59700 136 IF(N.NE.IQT)GO TO 236
59800 DO 1361 K=JD+1,LEND
59900 IF(INP(K).NE.IQT)GO TO 1361
60000 JD=K+1
60100 GO TO 975
60200 C SKIPS MATERIAL IN QUOTES
60300 1361 CONTINUE
60400 GO TO 99
60500 C OPEN QUOTES
60600 236 JD=JD+1
60700 IF(JD.LE.LEND)GO TO 975
60800 TYPE 1236
60900 GO TO 99
61000 1236 FORMAT(' NO END MARK')
62000 1899 CALL SCANR
62050 CZZZZZZZ ML=MLX
62075 CZZZZZZZZZZZZZZZZZZZZZZZZZZ
62100 GO TO(1,2,3,4,5,6),ISUB
00100 101 N=INP(ML)
00200 IZ=ML
00300 ML=ML+1
00400 IF(N.EQ.IBLA)GO TO 101
00500 C ⊗⊗⊗⊗⊗ MAY 13,71 @@@@@@@@@@
00600 JA=-1
00700 IF(N.EQ.IPP)GO TO 1
00800 IF(N.EQ.IE)GO TO 2308
00900 IF(N.EQ.'R')CALL RUNIT
01000 C 'RUN' MAY REPLACE 'END' FOR LAST INST.
01100 IF(N.EQ.ID)GO TO 7720
01200 GO TO 99
01300 1 CALL SCANR
01400 LPAR=VX1
01500 IJ=LPAR
01600 IF(QX.GE.0)GO TO 5703
01700 IJ=LPAR+4
01800 C SETS UP PARAM FOR QUAD CALL
01900 V(I)=IJ+LK*10000
02000 V(I+1)=2*ALL
02100 C TEST "ALL" FEATURE HERE!!!!!!!
02200 C X=-13(DEGREES),=-14(X,Y),=-15(CIRCLE FUNCTS),=-16(LINE FUNCTS)
02300 V(I+2)=QX
02400 I=I+3
02500 QX=0.
02600 5703 IAMP=0
02700 IF(IJ.GT.NP(LK).AND.IJ.LT.31)NP(LK)=IJ
02800 IF(LPAR.EQ.32)LPAR=1
02900 V(I)=LPAR+LK*10000
03000 C +1=WDCNT, +2=CODE, +3='NM' CCCCC
03100 IJ=I+1
03200 I=I+4
03300 ITMP=0
03400 CODE=0
03500 NFLG=1
03600 ML=IZ+M
03700 C RE=REP R=RHY L=LIT M=MOVE MX=MOVX N=NOTES NU=NUM
03800 C S--L=SUBL S--N=SUBN T=TAP RT=RTAP RL=RLIST RN=RNOTES
03900 C QU=QUADC QUX=QUADX
04000 5702 ML=ML+1
04100 CC IF(ML.GT.72)GO TO 99
04200 N=INP(ML)
04300 IF(N.EQ.IBLA.OR.N.EQ.',')GO TO 5702
04400 NL=INP(ML+1)
04500 JA=-1
04600 ISUB=0
04700 IF(N.EQ.IXX)GO TO 2703
04800 IF(N.EQ.'R')GO TO 6702
04900 IF(N.EQ.IF)GO TO 8702
05000 4005 JA=0
05100 IF(N.EQ.IEN)GO TO 6005
05200 IF(N.EQ.'M')GO TO 703
05300 IF(N.EQ.'L')GO TO 2720
05400 IF(N.EQ.ISS)GO TO 6703
05500 IF(N.EQ.ITT)GO TO 4018
05600 IF(N.EQ.IQT)GO TO 5720
05700 IF(N.EQ.ISEMI)GO TO 2018
05800 IF(N.EQ.IPP)JA=-1
05900 C FOR ;P5 P3;
06000 CALL SCANR
06100 IF(ISUB.EQ.8)GO TO 8
06200 I=I+JJ
06300 V(IJ+1)=NNUM+DF
06400 IF(JJ.EQ.1)GO TO 4006
06500 C IF NNUM IS '-2' THEN NOTES ARE PRINTED
06600 IF(NNUM.NE.-2)GO TO 5006
06700 IX=IJ+3
06800 DO 2006 K=2,JJ,3
06900 2006 CALL RANR(VX,K)
07000 C FOR RAN. SELEC. OF NOTES. FINDS HIGHEST NOTE.
07100 5006 IX=IJ+2
07200 DO 6006 K=1,JJ
07300 6006 V(IX+K)=VX(K)
07400 V(IX+JJ-2)=1.
07500 C ABOVE ENSURES THAT LAST RAND. UNIT REACHES 100% - 5/74 *********
07600 GO TO 3013
07700 4006 IF(JA)VX1=VX1/100.+9999.
07800 C CHANGES ;P5 P3; TO ;P5 9999.03; ***** CHECK OUT ON OTHER MACHINES!
07900 V(I-1)=VX1
08000 GO TO 3013
08100 6702 IF(NL.EQ.IE)GO TO 2703
08200 C JUMP IF "REP"
08300 IF(NL.EQ.ITT)GO TO 4018
08400 C JUMP IF "RTAP"
08500 CODE=-22
08600 IF(NL.EQ.'L')CODE=-46.0
08700 C JUMP IF "RLIST" (LIST OF RAND SELECTIONS)
08800 IF(NL.NE.IEN)GO TO 1016
08900 C JUMP IF NOT "RNOTES"
09000 JA=0
09100 C FOR SCANR
09200 CODE=-36.
09300 GO TO 1016
09400 6005 CODE=-33
09500 IF(NL.NE.'U')GO TO 1016
09600 CODE=-44.
09700 1610 JA=-1
09800 GO TO 1016
09900 8702 CODE=-35
10000 IF(NL.EQ.'U')GO TO 1016
10100 ML=ML+1
10200 CALL SCANR
10300 7 V(IJ+1)=CODE+DF
10400 V(IJ+2)=1.
10450 IF(VX1.GT.15)GO TO 99
10475 C TRAPS F NUMS >15.
10500 V(I)=VX1+85.
10600 GO TO 7703
10700 C******** MOVE IS NEXT ***********
10800 703 BW=V(IJ-2)
10900 IC=0
11000 CC DO 7031 K=ML+1,72
11010 DO 7031 K=ML+1,LEND
11100 IF(INP(K).EQ.KSLA)GO TO 8031
11110 CC IF(INP(K).EQ.ISEMI)GO TO 8031
11200 7031 IF(INP(K).EQ.IXX)IC=-1
11300 C IC=-1 IS FOR MOVX
11400 8031 I=I-1
11500 V(I)=0
11600 X=-9900.-BY
11700 IF(BY.EQ.0)X=-9900.-BG(LK)
11800 IF(BW.EQ.X)GO TO 8005
11900 IF(BW.NE.-9900.-BY)GO TO 1102
12000 V(IJ-2)=X
12100 GO TO 8005
12200 1102 V(IJ)=V(IJ-1)
12300 V(IJ-1)=X
12400 IJ=IJ+1
12500 I=I+1
12600 8005 LP=IJ-1
12700 BW=-9900.-X
12800 ISUB=2
12900 IZ=-1
13000 C ABOVE ARRANGES NECESSARY BG TIME HEADINGS.
13100 4703 GO TO 1299
13200 102 IF(IZ.LT.0)GO TO 2102
13300 C SKIPS NEXT FIRST TIME
13400 BW=V(ICT)+BW
13500 V(I)=-9900.-BW
13600 V(I+1)=V(LP)
13700 V(I+2)=(JJ+2)*ALL
13800 V(I+3)=CODE+DF
13900 I=I+4
14000 IZ=1
14100 2102 IF(BW.LT.10000.)CALL BGSORT(BW)
14200 C ROUND-OFF NONSENSE
14300 2 VX3=-9900.
14400 VX2=VX3
14500 CALL SCANR
14600 IF(JJ.GT.0)GO TO 5102
14700 JJ=ILIT
14800 C SLASH WILL REPEAT MOVE INPUT -- 6/74
14900 DO 6102 K=1,JJ
15000 6102 VX(K)=VX(K+20)
15100 GO TO 5005
15200 C::::::::::::::: PUT THIS, AND AT 5505, IN SCOR5 ALSO ::::::::::::::
15300 5102 IF(JJ.EQ.4)GO TO 99
15400 C ERROR -- 4 ITEMS IN MOVE IMPOSSIBLE
15500 IF(VX3.NE.-9900.)GO TO 3102
15600 IF(VX2.NE.-9900.)GO TO 4102
15700 VX2=VX1
15800 VX1=10000.
15900 4102 VX3=VX2
16000 JJ=3
16100 C 1,2 OR 3 NUMS CAN BE USED IN NON-RAN MOVES.
16200 3102 IF(IZ.GE.0)GO TO 3006
16300 V(IJ)=(JJ+2)*ALL
16400 C WORD COUNT
16500 CODE=-55.
16600 IF(JJ.NE.3)CODE=-57.
16700 IF(NFLG)CODE=CODE-1.
16800 IF(IC)CODE=-59.
16900 C CODE=-56 OR -58 FOR NOTES.
17000 V(IJ+1)=CODE+DF
17100 IZ=0
17200 3006 IF(NFLG.EQ.1)GO TO 5005
17300 CALL RANR(VX,2)
17400 IF(JJ.NE.3)CALL RANR(VX,4)
17500 C FOR RAN. SELEC. OF NOTES. FINDS HIGHEST NOTE.
17600 5005 ICT=I
17700 ILIT=JJ
17800 C SAVES FOR SLASH REPEAT FEATURE
17900 IJ=IJ+1
18000 DO 1006 K=1,JJ
18100 VX(20+K)=VX(K)
18200 C SAVES FOR SLASH REPEAT FEATURE
18300 1006 V(IJ+K)=VX(K)
18400 I=I+JJ
18500 IJ=I+2
18600 IF(IAMP.EQ.0)GO TO 1299
18700 C*************** MAY 18,71 ***** ALWAYS RESETS TO TIME 0 WHEN MOVE IS USED.
18800 V(I)=-9900.-BY
18900 GO TO 8703
19000
19100 7703 V(IJ)=4.*ALL
19200 8703 I=I+1
19300 GO TO 4773
19400 C FOR SUBROUTINES, -12=NUMS. -11=LETTERS.
19500 6703 CODE=-12.
19600 IF(INP(ML+3).EQ.'L')CODE=-11.
19700 V(IJ)=2.*ALL
19800 V(IJ+1)=CODE+DF
19900 I=I-1
20000 GO TO 4773
20100 4018 CNT(LK)=-9900.-BY
20200 P(LK)=V(I-4)
20300 CC 6/74 COLGATE JREAD=3
20400 CC 6/74 COLGATE GO TO 4400
20500 1444 IF(READER(JNP))CALL RUNIT
20600 C READS A LINE. IF END OF FILE, JUMPS.
20700 443 IF(LN.NE.0)REREAD 107,K,IPT(LK,1)
20800 IF(LN.EQ.0)REREAD 8001,IPT(LK,1)
20900 C NAME OF RHYTHM FILE. (ONLY ONE PER INST.) READS DATA JUST BEFORE RUN
20950 IF(J.EQ.'CONDU')GO TO 444
21000 IF(NL.NE.ITT)GO TO 2338
21100 CODE=-23.
21200 GO TO 1016
21300 2338 I=I-4
21400 GO TO 4773
21500 3018 CNT(KZY)=-9900.
21600 GO TO 1444
22200 444 P(KZY)=980000.
22300 GO TO 2308
22400 C CAN'T USE 'TAP' OR 'RTAP' WITH INST KZY IF USING 'CONDUCT'.
22500 C 'REP'
22600 2703 ML=ML+1
22700 VX1=0
22800 VX2=0
22900 VX3=0
23000 IF(N.EQ.IXX)GO TO 2704
23100 INP(ML)=IBLA
23200 INP(ML+1)=IBLA
23300 C WIPES OUT 'EP' IN 'REP'
23400 2704 CALL SCANR
23500 V(IJ)=3.
23600 V(IJ+1)=-66.0
23700 IF(VX1.EQ.32.)VX1=1.
23800 IF(VX1.EQ.0)VX1=LPAR
23900 IF(VX2.EQ.0)VX2=LK-1
24000 V(IJ+2)=VX1+VX2*10000.
24100 KL=VX2
24200 IF(DUR(LK).LT.0)DUR(LK)=DUR(KL)
24300 IF(VX3.EQ.0)GO TO 4773
24400 L=VX3
24500 ML=LK+1
24600 DO 1018 KL=ML,L
24700 IF(LPAR.GT.NP(KL).AND.LPAR.LT.31)NP(KL)=LPAR
24800 IF(DUR(KL))DUR(KL)=DUR(LK)
24900 C TO SET DUR WHEN DUPLICATING NOTES THAT END WITH 'END;;'
25000 V(I)=V(I-4)+10000.
25100 V(I+1)=3.
25200 V(I+2)=-66.
25300 V(I+3)=V(I-1)
25400 1018 I=I+4
25500 GO TO 4773
25600
25700 2018 IF(DF.EQ.0)GO TO 20181
25800 C NEXT FOR Pn SUBR/ I.E. NOTHING BUT P AND SUB CALL. 7/73
25900 V(IJ+1)=-201.
26000 V(IJ+2)=1.
26100 V(IJ+3)=0
26200 GO TO 7703
26300 20181 V(IJ)=3.
26400 V(IJ+1)=-66.
26500 V(IJ+2)=NW+LK*10000
26600 GO TO 4773
26700 C READS /P5 .3 "ABC" .7 "XYZ"/
26800
26900 8 V(IJ+1)=-77.+DF
27000 C DF HAS SUBR CALL INFO
27100 I=I+1
27200 VX(JJ-1)=1
27300 C FOR RAND. SINGLE LITS.
27400 DO 3722 K=1,JJ,2
27500 V(I)=VX(K)
27600 3722 I=I+1
27700 V(IJ+2)=JJ/2
27800 V(IJ+3)=I
27900 DO 4722 K=2,JJ,2
28000 KN=I
28100 I=I+1
28200 L=VX(K)
28300 DO 6722 KL=L,LEND
28400 IF(INP(KL).EQ.IQT)GO TO 4722
28500 IV(I)=INP(KL)
28600 6722 I=I+1
28700 4722 V(KN)=I-KN-1
28800 V(IJ)=(I-IJ)*ALL
28900 GO TO 4773
29000 2720 QTS=0
29100 ISUB=104
29200 GO TO 1299
29300
29400 104 DO 6721 K=ML,LEND
29500 JC=K+1
29600 IF(INP(K).EQ.IQT)GO TO 7721
29700 6721 IF(INP(K).EQ.KSLA.OR.INP(K).EQ.ISEMI)GO TO 7232
29800 C FOR REPEAT OF ITEM BY SLASH
29900 CC7232 DO 7231 K=I-1,1,-1
30000 CC CHNGD 6/74 IF(ABS(V(K)).GT.72.)GO TO 7231
30100 CC NL=V(K)
30200 CC DO 7230 KL=K,K+NL
30300 7232 DO 7230 KL=ILIT,ILIT+NLIT
30400 V(I)=V(KL)
30500 7230 I=I+1
30600 GO TO 27222
30700 7231 CONTINUE
30800
30900 5720 IAMP=-1
31000 JC=ML+1
31100 C FOR SINGLE 'LIT' ITEMS.
31200 7721 DO 1722 KL=JC+1,LEND
31300 IF(INP(KL).NE.IQT)GO TO 1722
31400 JD=KL-1
31500 ML=KL+1
31600 NLIT=KL-JC
31700 C EXTENT OF LIT ITEM IS FOUND
31800 GO TO 8721
31900 1722 CONTINUE
32000 C CAN'T USE SLASH FOR REPEAT AFTER @Q
32100 8721 V(I)=NLIT
32200 ILIT=I
32300 DO 9721 K=JC,JD
32400 C PUTS ITEM IN "IV" ARRAY
32500 I=I+1
32600 9721 IV(I)=INP(K)
32700 I=I+1
32800 27222 IF(IAMP.EQ.0)GO TO 1299
32900 2722 V(I)=999.
33000 QTS=-1.
33100 27221 V(IJ+1)=-88.+DF
33200 V(IJ)=(I-IJ+1)*ALL
33300 IJ=IJ+2
33400 V(IJ)=IJ+1
33500 I=I+1
33600 ISUB=1
33700 GO TO 1299
33800
33900 7720 V(I)=LK
34000 V(I+1)=3.
34100 V(I+2)=-67.
34200 ML=ML+4
34300 CALL SCANR
34400 V(I+3)=VX1
34500 I=I+4
34600 L=VX1
34700 IF(NP(LK).LT.NP(L))NP(LK)=NP(L)
34800 IF(DUR(LK).LT.0)DUR(LK)=DUR(L)
34900 GO TO 4773
35000 C TYPE 'DUPL N;' N=INST # TO BE DUPLICATED.
35100 142 FORMAT(I,15A5)
35200 1301 FORMAT(15A5)
35300 CCC2773 FORMAT(I,A5,72A1)
35400 CC2114 FORMAT(I,80A1)
35500 300 FORMAT(I,3F,A1)
35600 301 FORMAT(3F,A1)
35700 6 KB=KB+1
35800 IF(JED.GT.0)JED=0
35900 IF(J.EQ.'INSER')GO TO 1340
36000 OTH(KB,1)=VX1*100000.+VX2*100.+VX3
36100 GO TO 340
36200 1340 X=VX1
36300 IF(VX2.NE.0)X=1000000.+VX1*100000.+VX2
36400 OTH(KB,1)=X
36500 GO TO 1338
36600 C ABOVE IS TO PUT INSERT AFTER NOTE # OF A PARTICULAR
36700 C INSTRUMENT. FOR COMMENT AT START, SET BG TIME TO 1,1
36800 C - BEGIN LINE WITH <,END WITH ;
36900 C UP TO 75 CHARACTERS MAY BE TYPED.
37000 340 IF(VX3.NE.2)GO TO 1338
37100 IF(ITYP.GE.0)GO TO 449
37200 CC JREAD=5
37300 CC 6/74 COLGATE GO TO 4400
37400 IF(READER(JNP))CALL RUNIT
37500 C READS A LINE. IF END OF FILE, JUMPS.
37600 445 OTH(KB,3)=1.
37700 IF(LN.EQ.0)GO TO 447
37800 REREAD 300,K,OTH(KB,2)
37900 GO TO 1447
38000 447 REREAD 301,OTH(KB,2)
38100 1447 IF(JED)GO TO 2308
38200 3445 TYPE TEDIT
38300 ACCEPT 77732,K
38400 IF(K.EQ.IG)JED=-1
38500 IF(J.EQ.'INSER')GO TO 3446
38600 IF(K.NE.'Y'.OR.JED)GO TO 2308
38700 449 TYPE TPALN
38800 ACCEPT 301,OTH(KB,2)
38900 IF(JED)WRITE(21,301) OTH(KB,2)
39000 GO TO 2308
39100
39200 1338 IF(ITYP.GE.0)GO TO 1449
39300 CC JREAD=6
39400 CC 6/74 COLGATE GO TO 4400
39500 IF(READER(JNP))CALL RUNIT
39600 C READS A LINE. IF END OF FILE, JUMPS.
39700 446 IF(LN.EQ.0)GO TO 448
39800 REREAD 142,K,(OTH(KB,JD),JD=2,16)
39900 GO TO 1446
40000 448 REREAD 1301,(OTH(KB,JD),JD=2,16)
40100 1446 IF(JED)2446,3445,2446
40200 3446 IF(K.NE.'Y'.OR.JED)GO TO 2446
40300 1449 TYPE TPALN
40400 ACCEPT 1301,(OTH(KB,JD),JD=2,16)
40500 IF(JED)WRITE(21,1301)(OTH(KB,JD),JD=2,16)
40600 2446 X=OTH(KB,2)
40700 IF(J.EQ.'INSER'.AND.VX3.NE.0.AND.X.NE.'*')GO TO 6
40800 IF(X.EQ.'*')KB=KB-1
40900 C ALLOWS SEVERAL LINES OF 'INSERT' IF ANY 3RD #.
41000 C LAST LINE HAS '*' IN COLUMN 1.
41100 GO TO 2308
41200 C IF NO PARAM NUM IS GIVEN, ALL PARAMS MUST BE TYPED.
41300 C INSERT MAY INCLUDE 10 CHARS(P3-P30),
41400 C P2, A # ONLY. IF MORE THAN 1 PARAM IS TO BE EDITED AND
41500 C P2 IS ONE OF THEM, FIRST EDIT P2 TO DESIRED VALUE,
41600 C CHANGE P2 TO MINUS = THEN INSERT ENTIRE NOTE TO PLAY
41700 C JUST AFTER ORIGINAL NOTE(WHICH WILL BE A REST).
41800 C BX=INST N. Y=NOTE N. Z=PARAM N.
00100 1106 KTMP=1
00200 TP=60.
00300 IAMP=0
00400 BW=BY
00500 ITMP=-1
00600 ISUB=5
00700 JA=-1
00800 GO TO 2016
00900 3019 V(I)=990000.00
01000 V(I+1)=4.
01100 V(I+2)=VX1
01200 V(I+3)=VX2/TP
01300 V(I+4)=VX3/TP
01400 I=I+5
01500 BY=BW
01600 C SEPT 18, 70
01700 IF(VX1.EQ.0)GO TO 2308
01800 BW=BW+VX1
01900 V(I)=-9900.-BW
02000 I=I+1
02100 CALL BGSORT(BW)
02200 9003 IF(IAMP)GO TO 4003
02300 2016 VX3=0
02400 VX2=0
02500 GO TO 1299
02600 5 IF(VX2.NE.0)GO TO 105
02700 C 'TEMPO/120*;' OR 'TEMPO/1.5 72*;' IS OK.
02800 VX2=VX1
02900 VX1=0
03000 105 IF(VX3.EQ.0)VX3=VX2
03100 IF(VX2.LT.11.)TP=1.
03200 IF(J.EQ.ITMPO)GO TO 3019
03300 PCH(1,KTMP)=VX1
03400 PCH(2,KTMP)=VX2
03500 PCH(3,KTMP)=VX3
03600 C PCH(1)=TIME (2)=MM1 (3)=MM2
03700 KTMP=KTMP+1
03800 IF(IAMP.EQ.0)GO TO 2016
03900 4003 VX1=0
04000 IAMP=0
04100 VX2=VX3
04200 IF(J.EQ.ITMPO)GO TO 3019
04300 PCH(1,KTMP)=0
04400 PCH(2,KTMP)=VX2
04500 PCH(3,KTMP)=VX2
04600 C MM CAN BE FROM 11 UP ITMPO FACTOR FROM 10 DOWN.
04700 C UP TO 30 ITMPO CHANGES MAY BE MADE.
04800
04900 1016 IA=I
05000 IZ=1
05100 3100 V(I-2)=CODE+DF
05200 ISUB=3
05300 5016 IF(IAMP.GE.0)GO TO 1299
05400 117 IF(IZ-2)3013,9004,9004
05500 103 K=INP(ML)
05600 IF(K.EQ.ITT)GO TO 1106
05700 IF(K.EQ.KSLA)GO TO 1014
05710 IF(K.EQ.ISEMI)GO TO 1014
05755 CZZZZZZZZZZZZ CC ZZZZZZZZZZZZ
05800 IF(K.NE.IBLA) GO TO 1899
05900 ML=ML+1
06000 GO TO 103
06100 3 IF(VX1.EQ.-99.)GO TO 4022
06200 IF(CODE.EQ.-22.)GO TO 2017
06300 IF(CODE.LT.-23.OR.IZ/2*2.EQ.IZ)GO TO 17
06400 C CHECKS PAIRS OF NUMBERS FOR 'RTAP'
06500 2017 IF(VX1.EQ.10000.)GO TO 17
06600 VX1=4./VX1
06700 IF(JJ.NE.1)GO TO 2014
06800 V(I)=VX1
06900 GO TO 114
07000
07100 1217 IF(VX1.EQ.10000.)GO TO 114
07200 C FOR "FINE" IN LIST
07300 V(I+1)=VX2
07400 IF(CODE.EQ.-36.)CALL RANR(V,I)
07500 2217 I=I+1
07600 C SETS UP STRING OF RAND SELECTIONS
07700 GO TO 114
07800 3217 V(I)=V(I-2)
07900 V(I+1)=RB
08000 C FOR SLASH REPTS OF RAND SELEC UNITS. ("REP" CAN'T BE USED!)
08100 GO TO 2217
08200 C******** PUT IN ERROR TRAP FOR "REP" ETC. ******
08300
08400 2014 DO 9006 L=2,JJ
08500 IF(VX(L).EQ.0)GO TO 17
08600 9006 VX1=4./VX(L)+VX1
08700 JJ=1
08800 17 V(I)=VX1
08900 IF(CODE.EQ.-46..OR.CODE.EQ.-36.)GO TO 1217
08950 IF(CODE.EQ.-35.AND.VX1.GT.15)GO TO 99
08975 C FINDS F NUM.>15!
09000 C JUMP IF STRING OF RAND SELECS.
09100 IF(JJ.EQ.1)GO TO 114
09200 L=VX(JJ)-1
09300 X=V(I)
09400 NL=I+1
09500 I=L+I
09600 DO 1017 K=NL,I
09700 1017 V(K)=X
09800 C ADDS UP TOTAL OF NOTES IN SEQ.
09900 IZ=IZ+L
10000 GO TO 114
10100 1014 IF(CODE.EQ.-46..OR.CODE.EQ.-36.)GO TO 3217
10200 V(I)=RB
10300 C RB SAVES IT FOR SLASH REPEAT
10400 114 RB=V(I)
10500 I=I+1
10600 IZ=IZ+1
10700 GO TO 5016
10800 4022 JC=VX2+.3
10900 JD=VX3-.5
11000 IF(JJ.EQ.2)JD=1
11100 C********* MAY 19,71 ----MANY LINES ABOVE.
11200 IZ=IZ+JC*JD
11300 C JC=HOW MANY TIMES, JD=HOW MANY NOTES
11400 DO 1005 K=1,JD
11500 NL=I+JC-1
11600 DO 2005 L=I,NL
11700 2005 V(L)=V(L-JC)
11800 1005 I=I+JC
11900 RB=V(NL)
12000 C RB SAVES DATA FOR SLASH REPEAT FEATURE.
12100 GO TO 5016
12200
12300 9004 IF(ITMP.EQ.0)GO TO 3013
12500 IZ=IZ-1
12600 C***** JAN. 1974
12700 KA=1
12800 IC=1
12900 K=0
13000 J=1
13100 Z=0
13200 RC=0
13300 9007 Y=PCH(3,IC)/TP
13400 X=PCH(2,IC)/TP
13500 Z=PCH(1,IC)
13600 CALL SQYY(YY,X,Y,Z)
13700 XT(1)=X
13800 PR=RA
13900 RD=1
14000 RB=0
14100 ZZ=Z
14400 CALL ACCEL
18300 IF(K.NE.IZ.AND.RA.NE.10000.)GO TO 9007
18400 C********* MAY 13,71 OMITS REPEATED RHY. FEATURE.
18600 3013 X=I-IJ
18700 V(IJ+2)=X-3.
18800 V(IJ)=X*ALL
18900 IF(CODE.NE.-35)GO TO 4773
19000 M=IJ+3
19100 C SETS NUMBERS FOR FUNCS.
19200 DO 313 K=M,I-1
19300 313 IF(V(K).LT.85.)V(K)=V(K)+85.
19400 GO TO 4773
19500
22100 END